perm filename WAVE.F4[MUS,LCS] blob sn#161101 filedate 1975-05-29 generic text, type T, neo UTF8
00010	C DISPLAYS 12-BIT SOUND -- LOAD WITH UNPACK.FAI AND %LTVRLIB[MUS,LCS]
00100		INTEGER FW
00200		DIMENSION DP(1),WD(1024),FW(3,1024)
00300		CALL TYPLOC(-260,-512)
00310		TYPE 333
00320		ACCEPT 334,NM
00330		IF(NM.EQ.' ')NM='MUSAA'
00400		INC=512
00500	8	TYPE 20
00510		NZ=1024
00600		ACCEPT 21,J,NY
00625		NY=NY/3
00650	C  TYPE NUM AFTER NAME TO STEP MANY SMPLS AHEAD.
00700		IF(J.NE.0)INC=J
00900		CALL GETFIL(NM)
01000		JCNT=0
01100		KCNT=1
01200		JZ=0
01300	11	L=1
01400		LX=INC
01500	100	CALL FASTIN(WD(1),1024)
01510		NZ=NZ+1024
01520		IF(NZ.LT.NY)GO TO 100
01530		IF(NY.EQ.0)GO TO 101
01565		KCNT=(NZ-1024)*3
01582		JCNT=KCNT-1
01600	101	X=-1
01700		DO 2 K=1,1024
01800		IF(WD(K).NE.0)X=0
01900	2	CALL UNPACK(WD(K),FW(1,K),FW(2,K),FW(3,K))
02000		IF(X)GO TO 8
02100	C  GO BACK TO 8 IF NO MORE SOUND.
02200	1	CALL DDCLR
02300		X=1000.0/INC
02400	40	CALL DPYSET(1,DP,4000)
02500	C  WON'T DISPLAY MORE THAN 3072 SAMPLES AT ONCE
02600		CALL ALINE(-500,409,-500,-409)
02700		CALL ALINE(500,0,-500,0)
02800	10	Z=-500
02900		DO 4 K=L,LX
03000		JCNT=JCNT+1
03100		JZ=FW(K,1)
03200		IF(JZ.GT.2047)JZ=JZ-4096
03300		JY=JZ/5
03400		JX=Z
03500		CALL AVECT(JX,JY)
03600		IF(K.EQ.3072)GO TO 6
03700	4	Z=Z+X
03800	6	CALL DPYOUT(1)
03900	31	TYPE 22,KCNT,JCNT
04100	55	IF(J.EQ.-1)GO TO 7
04110		IF(J.EQ.-2)GO TO 12
04200	5	ACCEPT 21,J,NX
04210		IF(J.GT.3072)J=3072
04300	77	IF(J.GT.0)INC=J
04400		IF(J.GE.-2)GO TO 7
04410		IF(J.NE.-2)GO TO 9
04420	12	LX=L+NX
04430		JCNT=KCNT+NX-1
04450	C  STEPS SLOWLY (NX STEPS) AHEAD.
04460		GO TO 7
04500	9	LX=L+J
04600		JCNT=KCNT+J-1
04700		IF(LX.LT.0)LX=0
04800	CTYPE -1 TO "GO" BY INC, -2 TO "GO" BY SHORT UNITS, -n TO BACKUP n SAMPLES.
04900	7	L=LX+1
05000		LX=LX+INC
05100	C  LOOKS AT INC SAMPLES EACH TIME
05110		KCNT=JCNT+1
05200		IF(L.GT.3072)GO TO 11
05300		GO TO 1
05400	20	FORMAT(' TYPE NUM OF SAMPLES  ',$)
05410	333	FORMAT(' TYPE FILE NAME  ',$)
05420	334	FORMAT(A5)
05500	21	FORMAT(2I)
05600	22	FORMAT(' SMPL ',I5,' TO ',I5/)
05700		END